Attribute VB_Name = "modStringFunc"
Global GWCounter As Long

' String Parsing Functions Library v3.0
' (C) 2003 Flint D Million

' Error handling throughout these functions is quite
' simple. In this version all errors caused within one
' of the functions will display a dialog box, but will
' not halt program execution. Instead, they will return
' a null string to the calling procedure.

Function GetWord(ByVal InString As String, ByVal WordNumber As Integer, Optional Delimiter As String) As String
' This is beta release 3.0 of GetWord.

' This version of the function is highly optimized
' from past revisions.
' It now uses InStr to locate the next occurrence
' of the delimiter rather than parsing the data
' character by character.
' It is still fully back-compatible with all previous
' revisions of GetWord.

' Useful in an easter egg?
GWCounter = GWCounter + 1

If WordNumber < 1 Then Exit Function

Dim FinalString As String
Dim Buf As String
Dim CurrWord As Integer

' If the delimiter is nothing, assume it's space.
If Delimiter = "" Then Delimiter = " "

' Trim the delimiter to one character
Delimiter = Left$(Delimiter, 1)

' Check for obvious bug.
If Len(InString) = 0 Then Exit Function

' Add one delimiter to the end to account for
' retrieving the last word
Buf = InString & Delimiter

Do
  ' Do we still have anything to do?
  ' If the user requested a word higher than the word
  ' count, this will trigger.
  If InStr(Buf, Delimiter) = 0 Then FinalString = InString: Exit Do
  ' Replace the FinalString variable with the current
  ' word.
  FinalString = Left$(Buf, InStr(Buf, Delimiter) - 1)
  ' Update the buffer.
  Buf = Right$(Buf, Len(Buf) - InStr(Buf, Delimiter))
  ' Remove extraneous buffer space
  If Delimiter = " " Then
    Buf = Trim$(Buf)
  Else
    Buf = CTrim(Buf, Delimiter)
  End If
  ' Replace the trailing delimiter
  Buf = Buf & Delimiter
  
  CurrWord = CurrWord + 1
Loop Until CurrWord = WordNumber

GetWord = FinalString

End Function

Function GetFromWord(ByVal InString As String, ByVal WordNumber As Integer, Optional Delimiter As String) As String
' This is beta release 3.0 of GetFromWord.

' This version of the function is highly optimized
' from past revisions.
' It now uses InStr to locate the next occurrence
' of the delimiter rather than parsing the data
' character by character.
' It is still fully back-compatible with all previous
' revisions of GetFromWord.

' Useful in an easter egg?
GWCounter = GWCounter + 1

If WordNumber < 1 Then Exit Function

Dim Buf As String
Dim CurrWord As Integer

' If the delimiter is nothing, assume it's space.
If Delimiter = "" Then Delimiter = " "

' Trim the delimiter to one character
Delimiter = Left$(Delimiter, 1)

' Check for obvious bug.
If Len(InString) = 0 Then Exit Function
' And another
If WordNumber < 2 Then GetFromWord = InString: Exit Function

' Add one delimiter to the end to account for
' retrieving the last word
Buf = InString & Delimiter

Do
  ' Do we still have anything to do?
  ' If the user requested a word higher than the word
  ' count, this will trigger.
  If InStr(Buf, Delimiter) = 0 Then Buf = InString: Exit Do
  ' Update the buffer.
  Buf = Right$(Buf, Len(Buf) - InStr(Buf, Delimiter))
  ' Remove extraneous buffer space
  If Delimiter = " " Then
    Buf = Trim$(Buf)
  Else
    Buf = CTrim(Buf, Delimiter)
  End If
  ' Replace the trailing delimiter
  Buf = Buf & Delimiter
  
  CurrWord = CurrWord + 1
Loop Until CurrWord = WordNumber - 1

GetFromWord = CTrim(Buf, Delimiter)

End Function

Function IsWord(ByVal InString As String, ByVal WWord As Integer, Optional Delimiter As String) As Boolean
GWCounter = GWCounter + 1

Dim FinalString As String
Dim Buf As String
Dim CurrWord As Integer

' If the delimiter is nothing, assume it's space.
If Delimiter = "" Then Delimiter = " "

' Trim the delimiter to one character
Delimiter = Left$(Delimiter, 1)

' Check for obvious bug.
If Len(InString) = 0 Then Exit Function

' Add one delimiter to the end to account for
' retrieving the last word
Buf = InString & Delimiter

Do
  ' Do we still have anything to do?
  ' If the user requested a word higher than the word
  ' count, this will trigger.
  If InStr(Buf, Delimiter) = 0 Then FinalString = InString: Exit Do
  ' Replace the FinalString variable with the current
  ' word.
  FinalString = Left$(Buf, InStr(Buf, Delimiter) - 1)
  ' Update the buffer.
  Buf = Right$(Buf, Len(Buf) - InStr(Buf, Delimiter))
  ' Remove extraneous buffer space
  If Delimiter = " " Then
    Buf = Trim$(Buf)
  Else
    Buf = CTrim(Buf, Delimiter)
  End If
  ' Replace the trailing delimiter
  Buf = Buf & Delimiter
  
  CurrWord = CurrWord + 1
  
Loop Until Buf = Delimiter

If CurrWord < WWord Then IsWord = False Else IsWord = True

End Function

Function WordCount(ByVal InString As String, Optional Delimiter As String) As Integer
' This is beta release 3.0 of WordCount.

' Useful in an easter egg?
GWCounter = GWCounter + 1

Dim Buf As String
Dim CurrWord As Integer

' If the delimiter is nothing, assume it's space.
If Delimiter = "" Then Delimiter = " "

' Trim the delimiter to one character
Delimiter = Left$(Delimiter, 1)

' Check for obvious bug.
If Len(InString) = 0 Then Exit Function

' Add one delimiter to the end to account for
' retrieving the last word
Buf = InString & Delimiter

Do
  ' Extraordinary bug check
  If CurrWord > 16384 Then Exit Function
  
  ' Do we still have anything to do?
  ' If the user requested a word higher than the word
  ' count, this will trigger.
  If InStr(Buf, Delimiter) = 0 Then Buf = InString: Exit Do
  ' Update the buffer.
  Buf = Right$(Buf, Len(Buf) - InStr(Buf, Delimiter))
  ' Remove extraneous buffer space
  If Delimiter = " " Then
    Buf = Trim$(Buf)
  Else
    Buf = CTrim(Buf, Delimiter)
  End If
  ' Replace the trailing delimiter
  Buf = Buf & Delimiter
  
  CurrWord = CurrWord + 1
Loop Until Buf = Delimiter

WordCount = CurrWord

End Function

Function GetLine(ByVal InString As String, ByVal LineNumber As Integer)
' This is a simple drop-in!
InString = Replace(InString, vbLf, "")
GetLine = CTrim(GetWord(InString, LineNumber, vbCr), vbCr)
End Function

Function GetFromLine(ByVal InString As String, ByVal LineNumber As Integer)
' This is a simple drop-in!
InString = Replace(InString, vbLf, "")
GetFromLine = CTrim(GetFromWord(InString, LineNumber, vbCr), vbCr)
End Function

Function LineCount(ByVal InString As String)
' Another drop-in!
InString = Replace(InString, vbLf, "")
LineCount = WordCount(InString, vbCr)

End Function


Private Function CTrim(ByVal InString As String, ByVal CharTrim As String)
Dim LChecked As Boolean
Dim RChecked As Boolean

CharTrim = Left(CharTrim, 1)

    Do Until LChecked = True And RChecked = True
      If Left(InString, 1) <> CharTrim Then
        LChecked = True
      Else
        InString = Right(InString, Len(InString) - 1)
      End If
      
      If Right(InString, 1) <> CharTrim Then
        RChecked = True
      Else
        InString = Left(InString, Len(InString) - 1)
      End If
    Loop

CTrim = InString

End Function

Public Function LeadingZeroStr(ByVal Num As Variant, Zeroes As Integer) As String

Dim FinalResult As String
Dim WhereDec As Integer
Dim ZAlreadyExist As Integer

' This function converts a number to a string
' while adding a specific amount of leading
' zeroes if requested.
' It also does the liberty of stripping off the leading
' or trailing spaces

' Convert the number into a double
Num = CDbl(Num)

FinalResult = Trim$(Str$(Num))

' First find out if there's a decimal point.
WhereDec = InStr(FinalResult, ".")
If WhereDec = 0 Then WhereDec = Len(FinalResult) Else _
  WhereDec = WhereDec - 1
  
' Count number of digits in the whole number portion
' If greater, add appropriate number of zeroes
If Zeroes > WhereDec Then
  FinalResult = String$(Zeroes - WhereDec, "0") & FinalResult
End If

' Finished, return value

LeadingZeroStr = FinalResult

End Function

Public Function TrailingZeroStr(ByVal Num As Variant, Zeroes As Integer) As String

Dim FinalResult As String
Dim WhereDec As Integer
Dim ZAlreadyExist As Integer

' This function converts a number to a string
' while adding a specific amount of trailing
' zeroes if requested.
' It also does the liberty of stripping off the leading
' or trailing spaces

' Convert the number into a double
Num = CDbl(Num)

' First step is to determine whether the number
' is an integer or not.
' If it is, our job is easy.
If Int(Num) = Num Then
  ' Convert the number to a string
  FinalResult = Str$(Num)
  ' Trim the result
  FinalResult = Trim$(FinalResult)
  ' Add the appropriate number of zeroes
  FinalResult = FinalResult & "." & String$(Zeroes, "0")
  ' Done here!
Else
  ' Convert the number to a string
  FinalResult = Str$(Num)
  ' Trim the result
  FinalResult = Trim$(FinalResult)
  ' Look for the decimal point
  WhereDec = InStr(FinalResult, ".")
  ' Determine the number of already existing
  ' trailing digits
  ZAlreadyExist = Len(FinalResult) - WhereDec
  ' If there's more digits than requested by the
  ' user, just exit here, otherwise continue
  ' adding zeroes
  If ZAlreadyExist < Zeroes Then
    ' Find out how many zeroes to add
    ZAlreadyExist = Abs(ZAlreadyExist - Zeroes)
    ' Add the zeroes
    FinalResult = FinalResult & String$(ZAlreadyExist, "0")
  End If
End If

' If the decimal point is the first character, add a leading zero.
If Left$(FinalResult, 1) = "." Then FinalResult = "0" & FinalResult
' Finished, return value

TrailingZeroStr = FinalResult

End Function

Public Function DayHourMinSecString(ByVal Date1 As Date) As String
' This function converts a date into
' a string like the following:
' "4 days 02:34:10"
Dim FinalResult As String

' Put the number of days first
FinalResult = Trim(CInt(Int(Date1))) + " days "

' Place number of hours
FinalResult = FinalResult & LeadingZeroStr(Hour(Date1), 2) & ":"

' Place number of minutes
FinalResult = FinalResult & LeadingZeroStr(Minute(Date1), 2) & ":"

' Place number of seconds
FinalResult = FinalResult & LeadingZeroStr(Second(Date1), 2)

' Done, return result
DayHourMinSecString = FinalResult

End Function


